The World of Computer Software/The World of Computer Software.iso/faq-s.zip/EMAIL.PAS

Pascal/Delphi Source File | 1991-04-13 | 35KB | 1,222 lines

{$R-,S-,I-,D-,F+,V-,B-,N-,O+ }
{$M 65500,0,0 }

unit email;

interface

uses gentypes,configrt,gensubs,subs1,subs2,textret,flags,overlay,
     mailret,userret,overret1,mainr1,mainr2,statret,modem;

procedure emailmenu;

implementation

procedure emailmenu;
var lastread:integer;
    m:mailrec;
    incoming,outgoing:catalogrec;

  procedure addcatalog (var c:catalogrec; var m:mailrec; fpos:integer);
  begin
    m.fileindex:=fpos;
    if c.nummail=maxcatalogsize
      then c.additional:=c.additional+1
      else begin
        c.nummail:=c.nummail+1;
        c.mail[c.nummail]:=m
      end
  end;

  procedure writenummail (var c:catalogrec; txt:mstr);
  begin
    writeln (^B^M'You have '^S,c.nummail+c.additional,^R' ',txt,
             ' E-Mail',s(c.nummail),^R);
    if c.additional>0
      then writeln ('   Note: Of those, ',
                     numthings (c.additional,'is','are'),' uncataloged.')
  end;

  procedure readcatalogs;
  var m:mailrec;
      cnt:integer;
  begin
    seek (mfile,1);
    incoming.nummail:=0;
    incoming.additional:=0;
    outgoing.nummail:=0;
    outgoing.additional:=0;
    for cnt:=1 to filesize(mfile)-1 do begin
      read (mfile,m);
      if m.sentto=unum
        then addcatalog (incoming,m,cnt);
      if match(m.sentby,unam)
        then addcatalog (outgoing,m,cnt)
    end
  end;

  procedure readit (var m:mailrec);
  begin
    write (^B^M'Title:   '^S,m.title,^M'Sent by: '^S);
    if m.anon
      then
        begin
          write (anonymousstr);
          if issysop then write (' (',m.sentby,')')
        end
      else write (m.sentby);
    writeln (^M'Sent at: '^S,datestr(m.when),' at ',timestr(m.when));
    writeln;
    if not break then printtext (m.line)
  end;

  procedure readincoming (n:integer);
  var m:^mailrec;
      cnt:integer;
  begin
    m:=addr(incoming.mail[n]);
    readit (m^);
    if not (m^.read) then begin
      m^.read:=true;
      seek (mfile,m^.fileindex);
      write (mfile,m^)
    end;
    for cnt:=n+1 to incoming.nummail do
      if match(incoming.mail[cnt].sentby,m^.sentby) then begin
        writeln (^B^M'There''s more mail from ',m^.sentby,'!');
        exit
      end
  end;

  procedure listmail (var c:catalogrec);
  var n:integer;
      u:userrec;
      cnt:integer;
      m:mailrec;
  begin
    write ('Num  ');
    tab ('Title',30);
    write ('New  Sent ');
    if ofs(c)=ofs(incoming) then writeln ('by'^M) else writeln ('to'^M);
    if break then exit;
    for cnt:=1 to c.nummail do if not break then begin
      m:=c.mail[cnt];
      write (cnt:2,'.  ');
      if not break then tab (m.title,30);
      if not break then if m.read then write ('     ') else write ('New  ');
      if match(m.sentby,unam)
        then writeln (lookupuname (m.sentto))
        else writeln (m.sentby)
    end
  end;

  procedure writemail (var c:catalogrec; num:integer);
  begin
    seek (mfile,c.mail[num].fileindex);
    write (mfile,c.mail[num])
  end;

  function checklastread:boolean;
  begin
    if (lastread<0) or (lastread>incoming.nummail) then lastread:=0;
    checklastread:=lastread=0
  end;

  function getmsgnumber (var c:catalogrec; txt:sstr):integer;
  var n:integer;
      inc:boolean;
  begin
    inc:=ofs(c)=ofs(incoming);
    getmsgnumber:=0;
    if c.nummail=0 then begin
      if c.additional>0 then readcatalogs;
      if c.nummail=0 then writestr (^M'Sorry, no mail!');
      if inc then lastread:=0;
      exit
    end;
    input:=copy(input,2,255);
    if length(input)=0
      then if inc
        then n:=lastread
        else n:=0
      else n:=valu(input);
    if (n<1) or (n>c.nummail) then begin
      repeat
        writestr (^M'E-Mail Number to '+txt+' [?/List]:');
        if length(input)=0 then exit;
        if input='?' then listmail (c)
      until input<>'?';
      n:=valu(input);
      if (n<1) or (n>c.nummail) then n:=0
    end;
    getmsgnumber:=n
  end;

  procedure deletemail (var c:catalogrec; n:integer);
  begin
    delmail (c.mail[n].fileindex);
    writeln (c.mail[n].title,' by ',c.mail[n].sentby,' deleted.');
    readcatalogs
  end;

  procedure nextmail;
  begin
    lastread:=lastread+1;
    if lastread>incoming.nummail
      then
        begin
          lastread:=0;
          if incoming.additional>0
            then writeln ('You must delete some old mail first!')
            else writeln ('Sorry, no more mail!')
        end
      else readincoming (lastread)
  end;

  procedure readnum (n:integer);
  begin
    if (n<1) or (n>incoming.nummail) then begin
      lastread:=0;
      exit
    end;
    lastread:=n;
    readincoming (n)
  end;

  procedure readmail;
  begin
    readnum (getmsgnumber (incoming,'read'))
  end;

  procedure listallmail;
  begin
    if incoming.nummail>0 then begin
      writehdr ('incoming E-Mail');
      listmail (incoming)
    end;
    if outgoing.nummail>0 then begin
      writehdr ('outgoing E-Mail');
      listmail (outgoing)
    end
  end;

  procedure newmail;
  begin
    lastread:=0;
    repeat
      lastread:=lastread+1;
      if lastread>incoming.nummail then begin
        writeln ('No (more) new mail.');
        lastread:=0;
        exit
      end;
      if not incoming.mail[lastread].read then begin
        readincoming (lastread);
        exit
      end
    until hungupon
  end;

  procedure deleteincoming;
  var n:integer;
  begin
    if checklastread then begin
      n:=getmsgnumber (incoming,'delete');
      if n=0 then exit;
      lastread:=n
    end;
    deletemail (incoming,lastread);
    lastread:=lastread-1
  end;

  procedure killoutgoing;
  var n:integer;
  begin
    n:=getmsgnumber (outgoing,'Kill');
    if n<>0 then deletemail (outgoing,n)
  end;

  procedure autoreply;
  var n,un,line:integer;
      me:message;
      u:userrec;
      uname:mstr;
  begin
    if checklastread then begin
      n:=getmsgnumber (incoming,'Reply to');
      if n=0 then exit;
      lastread:=n
    end;
    with incoming.mail[lastread] do
    begin
     uname:=sentby;
     if length(uname)=0 then exit;
     un:=lookupuser (uname);
     if un=0 then writeln ('User not found.') else begin
       if anon and (ulvl<sysoplevel) then uname:=anonymousstr;
       seek (ufile,un);
       system.read (ufile,u);
       if u.emailannounce>-1 then begin
         writehdr (u.handle+'''s Announcement');
         printtext (u.emailannounce)
       end;
       writehdr ('Sending E-Mail to '+uname);
       emailing:=true;  {true}
       writestr('Subject: *');
       If Length(Input)=0 then exit;
       Title:=Input;
       line:=editor (me,false,'Re: '+title);
       emailing:=false;
       if line>=0 then addmail (un,line,me)
     end
    end;
    readcatalogs
  end;

  procedure viewoutgoing;
  var n:integer;
  begin
    n:=getmsgnumber (outgoing,'view');
    if n=0 then exit;
    readit (outgoing.mail[n])
  end;

  procedure showinfos;
  var n:integer;
  begin
    if checklastread then begin
      n:=getmsgnumber (incoming,'delete');
      if n=0 then exit;
      lastread:=n
    end;
    showinfoforms (incoming.mail[lastread].sentby)
  end;

  procedure editmailuser;
  var n:integer;
      m:mstr;
  begin
    if checklastread then begin
      n:=getmsgnumber (incoming,'edit the sender');
      if n=0 then exit;
      lastread:=n
    end;
    m:=incoming.mail[lastread].sentby;
    n:=lookupuser (m);
    if n=0 then begin
      writeln (^B^R'User ',m,' not found!');
      exit
    end;
    edituser (n)
  end;

  procedure writecurmsg;
  var b:boolean;
  begin
    b:=checklastread;
    write (^B^M^R'Current Message: '^S);
    if lastread=0
      then writeln ('None'^R)
      else with incoming.mail[lastread] do
        writeln (^R'#'^S,lastread,^R': '^S,title,^R' sent by '^S,sentby,^R)
  end;

  procedure showannouncement (un:integer);
  var u:userrec;
  begin
    seek (ufile,un);
    read (ufile,u);
    if u.emailannounce>-1 then begin
      writehdr (u.handle+'''s Announcement');
      printtext (u.emailannounce)
    end
  end;

  procedure copymsg (var m:mailrec; un:integer);
  var me:message;
      line:integer;
      b:boolean;
  begin
    me.anon:=m.anon;
    me.title:='Was from '+m.sentby;
    reloadtext (m.line,me);
    showannouncement (un);
    writestr ('Add a prologue? [A/Abort]: *');
    if match(input,'a') then exit;
    if yes then b:=reedit (me,true);
    line:=maketext (me);
    addmail (un,line,me);
    readcatalogs
  end;

  procedure copymail;
  var n,un,line:integer;
  begin
    if checklastread then begin
      n:=getmsgnumber (incoming,'copy');
      if n=0 then exit;
      lastread:=n
    end;
    n:=lastread;
    writestr ('User to copy it to:');
    if length(input)=0 then exit;
    un:=lookupuser (input);
    if un=0 then exit;
    copymsg (incoming.mail[n],un)
  end;

  procedure forwardmail;
  var n,un:integer;
  begin
    if checklastread then begin
      n:=getmsgnumber (incoming,'forward');
      if n=0 then exit;
      lastread:=n
    end;
    n:=lastread;
    writestr ('User to forward it to:');
    if length(input)=0 then exit;
    un:=lookupuser (input);
    if un=0 then exit;
    copymsg (incoming.mail[n],un);
    deletemail (incoming,n)
  end;

  const groupclassstr:array [groupclass] of string[8]=
          ('Public','Private','Personal');

  procedure opengfile;
  begin
    assign (gfile,bbsdatadir+'groups.dat');
    reset (gfile);
    if ioresult<>0 then begin
      close (gfile);
      rewrite (gfile)
    end
  end;

  procedure seekgfile (n:integer);
  begin
    seek (gfile,n-1)
  end;

  function ismember (var g:grouprec; n:integer):boolean;
  var cnt:integer;
  begin
    ismember:=true;
    for cnt:=1 to g.nummembers do
      if g.members[cnt]=n then exit;
    ismember:=false
  end;

  function groupaccess (var g:grouprec):boolean;
  begin
    if issysop then begin
      groupaccess:=true;
      exit
    end;
    groupaccess:=false;
    case g.class of
      publicgroup:groupaccess:=true;
      personalgroup:groupaccess:=g.creator=unum;
      privategroup:groupaccess:=ismember (g,unum)
    end
  end;

  function lookupgroup (nm:mstr):integer;
  var cnt:integer;
      g:grouprec;
  begin
    lookupgroup:=0;
    seekgfile (1);
    for cnt:=1 to filesize(gfile) do begin
      read (gfile,g);
      if groupaccess(g)
        then if match(g.name,nm)
          then begin
            lookupgroup:=cnt;
            exit
          end
    end
  end;

  procedure listgroups;
  var g:grouprec;
      cnt:integer;
  begin
    writestr (^M'Name                          Class'^M);
    if break then exit;
    seekgfile (1);
    for cnt:=1 to filesize(gfile) do begin
      read (gfile,g);
      if groupaccess(g) then begin
        tab (g.name,30);
        writeln (groupclassstr[g.class]);
        if break then exit
      end
    end
  end;

  function getgroupclass:groupclass;
  var k:char;
  begin
    repeat
      input[1]:=#0;
      writestr ('Group class p(U)blic, p(R)ivate, p(E)rsonal:');
      k:=upcase(input[1]);
      if k in ['U','R','E'] then begin
        case k of
          'U':getgroupclass:=publicgroup;
          'R':getgroupclass:=privategroup;
          'E':getgroupclass:=personalgroup
        end;
        exit
      end
    until hungupon;
    getgroupclass:=publicgroup
  end;

  procedure addmember (var g:grouprec; n:integer);
  begin
    if ismember (g,n) then begin
      writestr ('That person is already a member!');
      exit
    end;
    if g.nummembers=maxgroupsize then begin
      writestr ('Sorry, group is full!');
      exit
    end;
    g.nummembers:=g.nummembers+1;
    g.members[g.nummembers]:=n
  end;

  procedure addgroup;
  var g:grouprec;
      un:integer;
  begin
    writestr ('Group name:');
    if (length(input)=0) or (input='?') then exit;
    g.name:=input;
    if lookupgroup (g.name)<>0 then begin
      writestr (^M'Group already exists!');
      exit
    end;
    g.class:=getgroupclass;
    g.creator:=unum;
    g.nummembers:=0;
    writestr ('Include yourself in the group? *');
    if yes then addmember (g,unum);
    writestr (^M'Enter names of members, CR when done'^M);
    repeat
      writestr ('Member:');
      if length(input)>0 then begin
        un:=lookupuser (input);
        if un=0
          then writestr ('User not found!')
          else addmember (g,un)
      end
    until hungupon or (length(input)=0) or (g.nummembers=maxgroupsize);
    seek (gfile,filesize (gfile));
    write (gfile,g);
    writestr (^M'Group created!');
    writelog (13,1,g.name)
  end;

  function maybecreategroup (nm:mstr):integer;
  begin
    writestr ('Create group '+nm+'? *');
    if yes then begin
      addtochain (nm);
      addgroup;
      maybecreategroup:=lookupgroup (nm)
    end else maybecreategroup:=0
  end;

  function getgroupnum:integer;
  var groupname:mstr;
      gn:integer;
      g:grouprec;
  begin
    getgroupnum:=0;
    groupname:=copy(input,2,255);
    repeat
      if length(groupname)=0 then begin
        writestr (^M'  Group name [?/List]:');
        if length(input)=0 then exit;
        if input[1]='/' then delete (input,1,1);
        if length(input)=0 then exit;
        groupname:=input
      end;
      if groupname='?' then begin
        listgroups;
        groupname:=''
      end
    until length(groupname)>0;
    gn:=lookupgroup (groupname);
    if gn=0 then begin
      writestr ('Group not found!');
      gn:=maybecreategroup (groupname);
      if gn=0 then exit
    end;
    seekgfile (gn);
    read (gfile,g);
    if not groupaccess(g)
      then writestr ('Sorry, you may not access that group!')
      else getgroupnum:=gn
  end;

  procedure sendmail;
  var g:grouprec;

    procedure sendit (showeach:boolean);
    var un,line,cnt:integer;
        me:message;

      procedure addit (n:integer);
      begin
        if n<>unum then begin
          if showeach then writeln (lookupuname(n));
          addmail (n,line,me)
        end else deletetext (line)
      end;

    begin
      if g.nummembers<1 then exit;
      writehdr ('Sending E-Mail to '+g.name);
      sendstr:=g.name;
      nosendprompt:=true;
      line:=editor (me,true,'Sending E-Mail to '+g.name);
      nosendprompt:=false;
      sendstr:='';
      if line<0 then exit;
      addit (g.members[1]);
      if g.nummembers=1 then exit;
      writeln (^B^M);
      for cnt:=2 to g.nummembers do begin
    un:=g.members[cnt];
        if un<>unum then begin
      line:=maketext (me);
          if line<0 then begin
            writeln (cnt,' of ',g.nummembers,' completed.');
            exit
          end;
          addit (un);
          if emails>32760 then emails:=0;
          emails:=emails+1;
        end
      end;

      readcatalogs
    end;

    procedure sendtogroup;
    var gn:integer;
    begin
      gn:=getgroupnum;
      if gn=0 then exit;
      seekgfile (gn);
      read (gfile,g);
      sendit (true)
    end;

    procedure sendtousers;
    var cnt,un:integer;
    begin
      g.name:=input;
      un:=lookupuser (g.name);
      if un=0 then begin
        writestr (^M'User not found.');
        exit
      end;
      g.nummembers:=1;
      g.members[1]:=un;
      cnt:=1;
      showannouncement (un);
      repeat
        writestr ('Carbon copy #'+strr(cnt)+' to:');
        if length(input)>0 then begin
          un:=lookupuser (input);
          if un=0
            then writestr (^M'User not found!'^M)
            else if ismember (g,un)
              then writestr (^M'User is already receiving a copy!')
              else begin
                cnt:=cnt+1;
                g.nummembers:=cnt;
                g.members[cnt]:=un;
                showannouncement (un)
              end
        end
      until (length(input)=0) or (cnt=maxgroupsize);
      sendit (g.nummembers>1)
    end;

  begin
    writestr ('User to send E-Mail to [''/'' for Group]:');
    if length(input)<>0
      then if input[1]='/'
        then sendtogroup
        else sendtousers
  end;

  procedure zippymail;
  var un:integer;
      me:message;
      l:integer;
  begin
    writestr ('Send mail to:');
    if length(input)=0 then exit;
    un:=lookupuser (input);
    if un=0 then begin
      writestr ('No such user!');
      exit
    end;
    titlestr:='Zippy Mail';
    l:=editor (me,false,'Zippy Mail');
    if l<0 then exit;
    me.title:='-----';
    me.anon:=false;
    addmail (un,l,me);
    readcatalogs
  end;

  {overlay} procedure sysopmail;

    function sysopreadnum (var n:integer):boolean;
    var m:mailrec;
        k:char;
        done:boolean;

      procedure showit;
      begin
        writeln (^B^N^M'Number  '^S,n,
                     ^M'Sent by '^S,m.sentby,
                     ^M'Sent to '^S,lookupuname (m.sentto),
                     ^M'Sent on '^S,datestr(m.when),' at ',timestr(m.when),
                     ^M'Title:  '^S,m.title,^M);
        printtext (m.line);
      end;

      procedure changen (m:integer);
      var r2:integer;
      begin
        r2:=filesize(mfile)-1;
        if (m<1) or (m>r2) then begin
          writestr ('Continue scan at [1-'+strr(r2)+']:');
          m:=valu(input)
        end;
        if (m>=1) and (m<=r2) then begin
          n:=m-1;
          done:=true
        end
      end;

    var q:integer;
    begin
      sysopreadnum:=false;
      seek (mfile,n);
      read (mfile,m);
      showit;
      repeat
        done:=false;
        q:=menu ('Electronic-Mail Scan','ESCAN','QSERDNAC_#?');
        if q<0
          then changen (-q)
          else case q of
            1:sysopreadnum:=true;
            2:sendmail;
            3:edituser(lookupuser(m.sentby));
            4:edituser(m.sentto);
            5:delmail(n);
            6,9:done:=true;
            7:showit;
            8:changen (0);
            10:begin
writeln ('C╔═════════════════════════════════════╗Hs');
writeln ('uC║ Electronic-Mail Scan Section        ║Hs');
writeln ('uC╚═════════════════════════════════════╝HHC╔════s');
writeln ('u═════════════════════════════════╗HC║ [A]  s');
writeln ('uDisplay Mail                   ║HC║ [Cs');
writeln ('u]  Edit Mail                      ║HC║ [s');
writeln ('uD]  Delete Mail                    ║Hs');
writeln ('uC║ [E]  Edit User Sent from            s');
writeln ('u║HC║ [N]  Next Mail               s');
writeln ('u       ║HC║ [O]  Edit User Sent tos');
writeln ('u              ║HC║ [Q]  Quit      s');
writeln ('u                     ║HC║ [R]  Reas');
writeln ('ud Mail                      ║HC║ [S]  s');
writeln ('uSend Mail                      ║HC║ [#s');
writeln ('u]  Read Mail #                    ║HC║ s');
writeln ('u[CR] Next Mail                      ║Hs');
writeln ('uC║ [?]  View This Menu                 s');
writeln ('u║HC╚═════════════════════════════════════╝');
writeln;
pause;
           end;
          end
      until (q=1) or done or hungupon
    end;

    procedure someoneelse;
    var t,last:integer;
    begin
      writestr (^M'User name to look at:');
      if (length(input)=0) or hungupon then exit;
      writeln;
      t:=lookupuser (input);
      if t=0 then begin
        writestr ('No such user!');
        exit
      end;
      writelog (14,1,input);
      writestr ('Looking in mailbox...');
      last:=searchmail(0,t);
      if last=0 then writestr ('No mail.');
      while last<>0 do begin
        seek (mfile,last);
        read (mfile,m);
        if sysopreadnum (last) or hungupon then exit;
        last:=searchmail(last,t)
      end;
      writeln (^B^M'No more mail!')
    end;

    procedure scanall;
    var r1,r2:integer;
        u:userrec;
        n:mstr;
    begin
      r2:=filesize(mfile)-1;
      writestr ('Start scanning at [1-'+strr(r2)+']:');
      if length(input)=0 then r1:=1 else r1:=valu(input);
      if (r1<1) or (r1>r2) then exit;
      writelog (14,2,'');
      while r1<filesize(mfile) do begin
        seek (mfile,r1);
        read (mfile,m);
        if m.sentto<>0 then
          if sysopreadnum (r1) then exit;
        r1:=r1+1
      end;
      writeln (^B^M'No more mail!')
    end;

    procedure groupflags;
    var gn,bn,un,cnt:integer;
        bname:sstr;
        ac:accesstype;
        g:grouprec;
        u:userrec;
    begin
      writestr ('Grant all group members access to a sub-board'^M);
      gn:=getgroupnum;
      if gn=0 then exit;
      writestr ('  Sub-board access name/number:');
      writeln;
      bname:=input;
      opentempbdfile;
      bn:=searchboard(bname);
      closetempbdfile;
      if bn=-1 then begin
        writeln ('No such board!');
        exit
      end;
      writelog (14,3,bname);
      for cnt:=1 to g.nummembers do begin
        un:=g.members[cnt];
        writeln (lookupuname(un));
        seek (ufile,un);
        read (ufile,u);
        setuseraccflag (u,bn,letin);
        seek (ufile,un);
        write (ufile,u)
      end
    end;

    procedure deleterange;
    var first,last,num,cnt:integer;
    begin
      writehdr ('Mass Mail Delete');
      parserange (filesize(mfile)-1,first,last);
      if first=0 then exit;
      num:=last-first;
      if num<>1 then begin
        writeln ('Warning! ',num,' pieces of mail will be deleted!');
        writestr ('Are you sure? *');
        if not yes then exit
      end;
      for cnt:=last downto first do begin
        delmail (cnt);
        write (cnt,' ');
        if break then begin
          writestr (^B^M'Aborted!');
          exit
        end
      end;
      writeln
    end;

  var q:integer;
  begin
    repeat
      q:=menu ('Electronic-Mail Sysop','ESYSOP','QLSGD?');
      case q of
        2:someoneelse;
        3:scanall;
        4:groupflags;
        5:deleterange;
        6:begin
writeln ('C╔═════════════════════════════════════╗Hs');
writeln ('uC║ Electronic-Mail Sysop Section       ║Hs');
writeln ('uC╚═════════════════════════════════════╝HHC╔════s');
writeln ('u═════════════════════════════════╗HC║ [D]  s');
writeln ('uDelete Range of Mail           ║HC║ [Gs');
writeln ('u]  Use Group for Sub-Board Access ║HC║ [s');
writeln ('uL]  Look in Someone''s Mailbox     ║Hs');
writeln ('uC║ [Q]  Quit                           s');
writeln ('u║HC║ [S]  Scan All Mail           s');
writeln ('u       ║HC║ [?]  View This Menu   s');
writeln ('u              ║HC╚═══════════════════════════════A');
writeln ('C══════╝');
writeln;
pause;
           end;
      end
    until (q=1) or hungupon;
    readcatalogs
  end;

  {overlay} procedure announcement;

    procedure delannouncement;
    begin
      if urec.emailannounce=-1 then begin
        writestr (^M'You don''t HAVE an announcement.');
        exit
      end;
      deletetext (urec.emailannounce);
      urec.emailannounce:=-1;
      writeurec;
      writestr (^M'Deleted.')
    end;

    procedure createannouncement;
    var me:message;
    begin
      if urec.emailannounce>=0 then deletetext (urec.emailannounce);
      titlestr:='User Announcement';
      urec.emailannounce:=editor (me,false,'User Announcement');
      writeurec
    end;

  var k:char;
  begin
    if urec.emailannounce>=0
      then showannouncement (unum)
      else writestr ('You don''t have an announcement right now.');
    writestr (^M'[C]reate/replace, [D]elete, or [Q]uit:');
    if length(input)=0 then exit;
    k:=upcase(input[1]);
    case k of
      'D':delannouncement;
      'C':createannouncement
    end
  end;

  {overlay} procedure groupediting;
  var curgroup:integer;
      cg:grouprec;

    procedure selectgroup;
    var n:integer;
        g:grouprec;
    begin
      delete (input,1,1);
      repeat
        if length(input)=0 then writestr ('Select group [?/List]:');
        if length(input)=0 then exit;
        if input='?' then begin
          listgroups;
          n:=0;
          input[0]:=#0
        end else begin
          n:=lookupgroup (input);
          if n=0 then begin
            writestr ('Group not found!');
            exit
          end
        end
      until n>0;
      seekgfile (n);
      read (gfile,g);
      if groupaccess(g) then begin
        curgroup:=n;
        cg:=g
      end else writestr ('You can''t access that group.')
    end;

    function nocurgroup:boolean;
    begin
      nocurgroup:=curgroup=0;
      if curgroup=0 then writestr ('No group as been S)elected!')
    end;

    function notcreator:boolean;
    var b:boolean;
    begin
      if nocurgroup then b:=true else begin
        b:=(unum<>cg.creator) and (not issysop);
        if b then writestr ('You aren''t the creator of this group!')
      end;
      notcreator:=b;
    end;

    procedure writecurgroup;
    begin
      seekgfile (curgroup);
      write (gfile,cg)
    end;

    procedure deletegroup;
    var cnt:integer;
        g:grouprec;
    begin
      if notcreator then exit;
      writestr ('Delete group '+cg.name+': Are you sure? *');
      if not yes then exit;
      writelog (13,2,cg.name);
      for cnt:=curgroup to filesize(gfile)-1 do begin
        seekgfile (cnt+1);
        read (gfile,g);
        seekgfile (cnt);
        write (gfile,g)
      end;
      seek (gfile,filesize(gfile)-1);
      truncate (gfile);
      curgroup:=0
    end;

    procedure listmembers;
    var cnt:integer;
    begin
      if nocurgroup then exit;
      writeln ('Creator:           '^S,lookupuname (cg.creator));
      writeln ('Number of members: '^S,cg.nummembers,^M);
      for cnt:=1 to cg.nummembers do begin
        if break then exit;
        writeln (cnt:2,'. ',lookupuname (cg.members[cnt]))
      end
    end;

    procedure readdmember;
    var n:integer;
    begin
      if notcreator then exit;
      writestr ('User to add:');
      if length(input)=0 then exit;
      n:=lookupuser (input);
      if n=0
        then writestr ('User not found!')
        else begin
          addmember (cg,n);
          writecurgroup
        end
    end;

    procedure removemember;

      procedure removemembernum (n:integer);
      var cnt:integer;
      begin
        cg.nummembers:=cg.nummembers-1;
        for cnt:=n to cg.nummembers do cg.members[cnt]:=cg.members[cnt+1];
        writecurgroup;
        writestr ('Member removed.')
      end;

    var cnt,n:integer;
    begin
      if notcreator then exit;
      repeat
        writestr ('User to remove [?/List]:');
        if length(input)=0 then exit;
        if input='?' then begin
          input[0]:=#0;
          listmembers
        end
      until length(input)>0;
      n:=lookupuser (input);
      if n=0 then begin
        writestr ('User not found!');
        exit
      end;
      for cnt:=1 to cg.nummembers do if cg.members[cnt]=n then begin
        removemembernum (cnt);
        exit
      end;
      writestr ('User isn''t in the group!')
    end;

    procedure setclass;
    begin
      if notcreator then exit;
      writeln ('Current class: '^S,groupclassstr [cg.class],^M);
      cg.class:=getgroupclass;
      writecurgroup
    end;

    procedure setcreator;
    var m:mstr;
        n:integer;
    begin
      if notcreator then exit;
      writeln ('Current creator: '^S,lookupuname(cg.creator),^M);
      writestr ('Enter new creator:');
      if length(input)=0 then exit;
      n:=lookupuser(input);
      if n=0 then begin
        writestr ('User not found!');
        exit
      end;
      cg.creator:=n;
      writecurgroup;
      if (n<>unum) and (not issysop) then curgroup:=0
    end;

    procedure addbylevel;
    var n,cnt:integer;
        u:userrec;
    begin
      if notcreator then exit;
      writestr ('Let in all people over level:');
      n:=valu(input);
      if n=0 then exit;
      seek (ufile,1);
      for cnt:=1 to numusers do begin
        read (ufile,u);
        if (length(u.handle)>0) and (u.level>=n) then begin
          if cg.nummembers=maxgroupsize then begin
            writestr ('Sorry, group is full!');
            exit
          end;
          addmember (cg,cnt)
        end
      end
    end;

  var q:integer;
  begin
    curgroup:=0;
    repeat
      write (^B^M^M^R'Group selected: '^S);
      if curgroup=0
        then writeln ('None')
        else writeln (cg.name);
      q:=menu ('Group Editing','GROUP','QS*LGDVMRCAE?');
      case q of
        2,3:selectgroup;
        4:listgroups;
        5:addgroup;
        6:deletegroup;
        7:listmembers;
        8:readdmember;
        9:removemember;
        10:setcreator;
        11:setclass;
        12:addbylevel;
        13:begin
writeln ('C╔═════════════════════════════════════╗Hs');
writeln ('uC║ Group Editing Section               ║Hs');
writeln ('uC╚═════════════════════════════════════╝HHC╔════s');
writeln ('u═════════════════════════════════╗HC║ [A]  s');
writeln ('uSet Class                      ║HC║ [Cs');
writeln ('u]  Change Creator                 ║HC║ [s');
writeln ('uD]  Delete Group                   ║Hs');
writeln ('uC║ [E]  Add by Level                   s');
writeln ('u║HC║ [G]  Add Group               s');
writeln ('u       ║HC║ [L]  List Group       s');
writeln ('u              ║HC║ [M]  Read Groups');
writeln ('u Mail                ║HC║ [Q]  Quis');
writeln ('ut                           ║HC║ [R]  s');
writeln ('uRemove Member                  ║HC║ [Ss');
writeln ('u]  Select Group                   ║HC║ s');
writeln ('u[V]  List Members                   ║Hs');
writeln ('uC║ [*]  Select Group                   s');
writeln ('u║HC║ [?]  View This Menu          s');
writeln ('u       ║HC╚═════════════════════════════════════╝');
writeln;
pause;
           end;
      end
    until hungupon or (q=1)
  end;

var q:integer;
begin
  cursection:=emailsysop;
  writehdr ('FAQ Electronic-Mail Service');
  opengfile;
  readcatalogs;
  writenummail (incoming,'incoming');
  writenummail (outgoing,'outgoing');
  lastread:=0;
  repeat
    writecurmsg;
    q:=menu ('Electronic-Mail','EMAIL','QRSLN_%@DKAV#E@CFGI@Z?');
    if q<0
      then readnum (abs(q))
      else case q of
        2:autoreply;
        3:sendmail;
        4:listallmail;
        5:newmail;
        6:nextmail;
        7:sysopmail;
        8:deleteincoming;
        9:killoutgoing;
        10:announcement;
        11:viewoutgoing;
        13:editmailuser;
        14:copymail;
        15:forwardmail;
        16:groupediting;
        17:showinfos;
        18:zippymail;
        19:begin
writeln ('C╔═════════════════════════════════════╗Hs');
writeln ('uC║ Electronic-Mail Section             ║Hs');
writeln ('uC╚═════════════════════════════════════╝HHC╔════s');
writeln ('u═════════════════════════════════╗HC║ [A]  s');
writeln ('uEdit/Create Announcement       ║HC║ [Cs');
writeln ('u]  Copy Mail                      ║HC║ [s');
writeln ('uD]  Delete Incoming                ║Hs');
writeln ('uC║ [E]  Edit User Sent from            s');
writeln ('u║HC║ [F]  Forward Mail            s');
writeln ('u       ║HC║ [G]  Group Edit       s');
writeln ('u              ║HC║ [I]  Infoforms s');
writeln ('ufor Sent from User   ║HC║ [K]  Kils');
writeln ('ul Outgoing                  ║HC║ [L]  s');
writeln ('uList Mail     ╔══════════════════════════════════s');
writeln ('u═══╗HC║ [N]  New Mail      s');
writeln ('u║ [S]  Send Mail                      ║');
writeln ('HC║ [Q]  Quit          ║ [s');
writeln ('uV]  View Outgoing                  ║Hs');
writeln ('uC║ [R]  Read Mail     ║ [s');
writeln ('uZ]  Zippy Mail                     ║Hs');
writeln ('uC╚════════════════════║ [#]  s');
writeln ('uRead Mail #                    ║HC║ [CRs');
writeln ('u] Read Next Mail                 ║HC║ [s');
writeln ('u?]  View This Menu                 ║HA');
writeln ('C╚═════════════════════════════════════╝');
writeln;
pause;
           end;
      end
  until hungupon or (q=1);
  close (gfile)
end;

begin
end.